home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / emacs-18.59src.lha / emacs-18.59 / amiga / contrib / lindgren / icons.el next >
Encoding:
Text File  |  1993-09-30  |  1.9 KB  |  50 lines
  1. ;;
  2. ;;      A new icon-creating scheme.
  3. ;;  When creating icons, the following replacement routine searches
  4. ;;  for icons of the name "def_<extension>.info".
  5. ;;  The routine searches first in the directories specified by the
  6. ;;  user in the variable "amiga-icon-path" and then in "env:Icons/".
  7. ;;  The directories in the list must contain the trailing slash.
  8. ;;
  9. ;;  If it can't find any appropriate icons, and the file
  10. ;;  "env:Icons/def_emacs.info" exists, it is used. Otherwise
  11. ;;  the original function is called.
  12. ;;
  13. ;;  Note that icons are only created when the variable
  14. ;;  "amiga-create-icons" is non-nil.
  15. ;;
  16. ;;  Example: If the user would like to use the icons supplied by
  17. ;;           the SAS C-complier, the following lines could be placed
  18. ;;           in his or hers .emacs file:
  19. ;;      (setq amiga-icon-path '("sc:Icons/"))
  20. ;;      (setq amiga-create-icons t)
  21. ;;
  22.  
  23. (defvar amiga-icon-path '()
  24.   "A list of directories to scan when searching for new icons.")
  25.  
  26. (if (not (fboundp 'old-amiga-put-icon))
  27.     (fset 'old-amiga-put-icon (symbol-function 'amiga-put-icon)))
  28.  
  29. (defun amiga-put-icon (file force)
  30.   (if (or force (not (file-readable-p (concat file ".info"))))
  31.       (let ((extpos (string-match "\\.[a-zA-Z]\\'" file))
  32.             (iconname nil)
  33.             (path (append amiga-icon-path '("env:icons/")))
  34.             (found nil))
  35.         (if (and extpos (< 0 extpos))
  36.             (while (and (not found) path)
  37.               (setq iconname (concat (car path) "def_" (substring file (+ 1 extpos)) ".in\
  38. fo"))
  39.               (if (and iconname (file-readable-p iconname))
  40.                   (progn
  41.                     (copy-file iconname (concat file ".info"))
  42.                     (setq found t)))
  43.               (setq path (cdr path))))
  44.         (if (not found)
  45.             (if (file-readable-p "env:Icons/def_emacs.info")
  46.                 (copy-file "env:Icons/def_emacs.info" (concat file ".info"))
  47.               (old-amiga-put-icon file force))))))
  48.  
  49.  
  50.